perm filename FLTR.F4[SCR,LCS] blob sn#204256 filedate 1976-03-01 generic text, type T, neo UTF8
00100	C******* 'FILTER' -- AVOIDS FOLDOVER ON HIGH NOTES *********
00200		SUBROUTINE SUBR
00300		DIMENSION PX(30)
00400		COMMON /INS/ INST(27),BG(60)
00500		COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
00600	C   INUM=INST#  IPAR=PARAM#  
00700	C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
00800	C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
00900	C   INST=INST. NAME,  BG=INSTS' BEGIN TIMES.
01000	C   NOTE #S IN SUBROUTINE: (1-84)  C4=37  FS4=43  C5=49  ETC.
01100	C   F1=86  F15=100 (NO F16!)
01200	
01300		IF(INUM.NE.1)GO TO 1
01400		X=P(3)
01500	C  WE'LL SAVE THE FREQ. IN X.
01600		IF(PL(3).EQ.1)RETURN 
01700	C NEXT FOR LETTER NAMED NOTES
01800		X=IFIX(X)
01900	C  FIX THE NOTE NUM. IN CASE IT WAS RANDOMLY SELECTED.
02000		X=30.8677*2**(X/12.)
02100		RETURN
02200	
02300	C NEXT SETS UP SYNTH VALUES.
02400	1	S=P(29)*500.
02500	C HALF THE SAMPLE RATE.
02600		P(29)=999.
02700	C  999 TO CONCLUDE SYNTH INPUT TO MUSIC PROG.
02800		K=S/X
02900	C HOW MANY TIMES WILL THE FREQ. FIT INTO THE SRATE.
03000		IF(K.LT.14)GO TO 3
03100	4	IF(BT.GT.0)IREST=-1
03200	C  GIVE INVIS. "INSTRUMENT" A REST IF NO CHANGE.
03300		RETURN
03310	C  RETURN IF THEY ALL FIT
03400	3	J=(K-2)*2
03500	C  FOR DO-LOOP BELOW
03600		F=1.0
03700		DO 2 L=J,28,2
03710		F=F-.25
03750		IF(L.LT.4)GO TO 2
03780		IF(F.LE.0)GO TO 20
03800		P(L)=P(L)*F
03900	C  SCALE DOWN THIS HARMONIC
04000		GO TO 2
04200	20	P(L)=0
04300	C ZERO OUT THIS HARMONIC
04400	2	CONTINUE
04500	C  NEXT TO SAVE TIME IN THE MUSIC PROGRAM.
04600		DO 5 K=4,28,2
04700	C JUMP OUT OF LOOP IF SOME CHANGE IS ENCOUNTERED.
04800	5	IF(P(K).NE.PX(K))GO TO 6
04900		GO TO 4
05000	C  TURN IT INTO A REST IF NO CHANGES FROM LAST TIME
05100	
05200	6	DO 7 L=K,28,2
05300	7	PX(L)=P(L)
05400	C  SAVE VALUES FOR NEXT TIME AROUND.
05500		RETURN
05600		END
05650	
05690	C **** TYPICAL INPUT ****
05700	C TOOT 0 12;
05800	C P2 .2;
05900	C P3 MOVE/6 C3 B7/6 B7 C3;
06000	C P4 2000;
06100	C P5 F1;
06200	C P6 F3 SUBR;
06300	C END;
06400	C FUNC INVIS 0 12;
06500	C P2 P2;
06600	C P3 "SYNTH(F3);1 1 2";
06700	C P4 .9;  % OF 2ND HARM.
06800	C P5 3;   P6 .85;  P7 4;   P8 .8;
06900	C P9 5;   P10 .75;  P11 6;   P12 .7;
07000	C P13 7;   P14 .65;  P15 8;   P16 .6;
07100	C P17 9;   P18 .55;  P19 10;   P20 .5;
07200	C P21 11;   P22 .45;  P23 12;   P24 .4;
07300	C P25 13;   P26 .35;  P27 14;   P28 .3;
07400	C P29 12.8 SUBR;  SAMPLE RATE IN K.
07500	C END;